with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with Ada.Containers.Hashed_Maps;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;
with System; use System;
with Interfaces.C; use Interfaces.C;
with GNAT.Task_Lock; use GNAT.Task_Lock;

package body Jni is

   protected type Semaphore(Start_Count: Integer := 1) is
      entry Secure;
      procedure Release;
   private
      Count: Integer := Start_Count;
   end Semaphore;

   protected body Semaphore is
      entry Secure when Count > 0 is
      begin
         Count := Count - 1;
      end Secure;

      procedure Release is
      begin
         Count := Count + 1;
      end Release;
   end Semaphore;

   Lock: Semaphore;

   -- IDs
   function findClass(E: JNIEnv; name: String) return jclass is
      C_Name: Char_Array := To_C(Name);
      Result: Jclass;
   begin
      Lock.Secure;
      -- Check if there is a pending exception
      Result := E.all.FindClass(E, C_Name(C_Name'First)'Access);
      if Boolean_To_Ada(E, E.all.ExceptionCheck(E)) or Result = Null_Address then
--           Put_Line("Unable to retrieve class " & Name);
--           E.all.ExceptionDescribe(E);
         E.all.ExceptionClear(E);
         --           Raise_Java_Exception(E, "Unable to retrieve class " & Name);
         raise Class_Not_Found with "Unable to retrieve class: " & name;
--           return Null_Address;
      end if;
      Lock.Release;
      return Result;
   end findClass;

   function getMethodID(E: JNIEnv; clazz : jclass; name, sig: String) return jfieldID is
      C_Name: Char_Array := To_C(Name);
      C_Sig: Char_Array := To_C(Sig);
      Result: JMethodID;
   begin
      Lock.Secure;
      Result := E.all.GetMethodID(E, Clazz, C_Name(C_Name'First)'Access, C_Sig(C_Sig'First)'Access);
      Lock.Release;
      return Result;
   end GetMethodID;

   function GetStaticMethodID(E: JNIEnv; Clazz : Jclass; Name, Sig: String) return JfieldID is
      C_Name: Char_Array := To_C(Name);
      C_Sig: Char_Array := To_C(Sig);
      Result: JMethodID;
   begin
      Lock.Secure;
      Result := E.all.GetStaticMethodID(E, Clazz, C_Name(C_Name'First)'Access, C_Sig(C_Sig'First)'Access);
      Lock.Release;
      return Result;
   end GetStaticMethodID;

   function getFieldID(E: JNIEnv; clazz : jclass; name, sig: String) return jfieldID is
      C_Name: Char_Array := To_C(Name);
      C_Sig: Char_Array := To_C(Sig);
      Result: JfieldID;
   begin
      Lock.Secure;
      -- Call JVM
      Result := E.all.GetFieldID(E, Clazz, C_Name(C_Name'First)'Access, C_Sig(C_Sig'First)'Access);

      -- BUG 676 - corruption of memory during getField
      -- Fixed by placing a semaphore around calls to JNI

      -- Check if there is a pending exception
      if Boolean_To_Ada(E, E.all.ExceptionCheck(E)) or Result = Null_Address then
--           put_line("Unable to retrieve field [" & Name&"]");
--           E.all.ExceptionDescribe(E);
         E.all.ExceptionClear(E);
--           Raise_Java_Exception(E, "Unable to retrieve class " & Name);
--           return Null_Address;
         raise Class_Not_Found with "Unable to retrieve field: " & name;
      end if;
      Lock.Release;
      return Result;
   end getFieldID;

   -- Strings
   function String_To_Ada(E: JNIEnv; S: Jstring) return String is
      Chars: Cs.Chars_Ptr;
   begin
      Lock.Secure;
      Chars := E.all.GetStringUTFChars(E, S, null);
      declare
         Result: String := CS.Value(Chars);
      begin
         E.all.ReleaseStringUTFChars(E,S,Chars);
         Lock.Release;
         return Result;
      end;
   end String_To_Ada;

   function String_To_Java(E: JNIEnv; S: String) return Jstring is
      Chars: char_array := To_C(S);
      Result: Jstring;
   begin
      Lock.Secure;
      Result := E.all.NewStringUTF(E, Chars(Chars'First)'Access);
      Lock.Release;
      return Result;
   end String_To_Java;

   -- Bools
   function Boolean_To_Ada(E: JNIEnv; B: Jboolean) return Standard.Boolean is
   begin
      return B = JNI_TRUE;
   end Boolean_To_Ada;

   function Boolean_To_Java(E: JNIEnv; B: Standard.Boolean) return JBoolean is
   begin
      if B then
         return JNI_TRUE;
      else
         return JNI_FALSE;
      end if;
   end Boolean_To_Java;

   -- Arrays
   type jboolean_Array is array (Integer range <>) of jboolean;
   function To_Ada(E: JNIEnv; A: jbooleanArray) return Boolean_Array_Ptr is
      result: Boolean_Array_Ptr;
      elements: System.Address;
   begin
--        elements := E.all.GetPrimitiveArrayCritical(E, A, null);
      for i in result'first .. result'last loop
         --           result(i) := elements(i) = JNI_TRUE;
         null;
      end loop;
--        E.all.ReleasePrimitiveArrayCritical(E, elements);
      return result;
   end To_Ada;

   function To_Java(E: JNIEnv; A: Boolean_Array_Ptr) return jbooleanArray is
      result: jbooleanArray;
   begin
      return result;
   end To_Java;


   function To_Ada(E: JNIEnv; A: jintArray) return Integer_Array_Ptr is
      result: Integer_Array_Ptr;
      elements: System.Address;
   begin
--        elements := E.all.GetPrimitiveArrayCritical(E, A, null);
      for i in result'first .. result'last loop
         --           result(i) := elements(i) = JNI_TRUE;
         null;
      end loop;
--        E.all.ReleasePrimitiveArrayCritical(E, elements);
      return result;
   end To_Ada;

   function To_Java(E: JNIEnv; A: Integer_Array_Ptr) return jintArray is
      result: jintArray;
   begin
      return result;
   end To_Java;

   -- Proxy factory
   package Proxy_Map is new Ada.Containers.Hashed_Maps
     (Key_Type => Unbounded_String,
      Element_Type => Tag,
      Hash => Ada.Strings.Unbounded.Hash,
      Equivalent_Keys => "=");

   Proxy_Registry: Proxy_Map.Map;

   procedure Register(T: Tag; Class: String) is
   begin
      Proxy_Registry.Insert(To_Unbounded_String(Class), T);
   end Register;

   function Get_Tag(Class: String) return Tag is
   begin
      return Proxy_Registry.Element(To_Unbounded_String(Class));
   end Get_Tag;

   function Make_Proxy(E: JNIEnv; Obj: JObject) return Proxy'Class is
--        O_Class: JClass := E.all.GetObjectClass(E, Obj);
--        Class: JClass := E.all.GetObjectClass(E, O_Class);
--        Name_Method: JMethodID := GetMethodID(E, Class, "getName", "()Ljava/lang/String;");
--        Interfaces_Method: JMethodID := GetMethodID(E, Class, "getInterfaces", "()[Ljava/lang/Class");
--        Interfaces: Jarray := E.all.CallObjectMethodA(E, O_Class, Interfaces_Method, null);
      T: Tag;
      P: aliased Params := (E, Obj);
--        L: jsize := E.all.GetArrayLength(E, Interfaces);
   begin
--        for I in 0 .. L loop
--           declare
--              Interface_Class : Jclass := E.all.GetObjectArrayElement(E, Interfaces, I);
--              Interface_Name: String := To_Ada(E, E.all.CallObjectMethodA(E, Interface_Class, Name_Method, null));
--           begin
--              if Proxy_Registry.Contains(To_Unbounded_String(Interface_Name)) then
--                 return Make_Proxy(Get_Tag(Interface_Name), P'Access);
--              end if;
--           end;
--        end loop;
      raise Error;
      return Make_Proxy(T,P'Access);
   end Make_Proxy;

   -- Exceptions
   procedure Raise_Java_Exception(E: JNIEnv; Message: String) is
      Class: Jclass := Findclass(E, "java/lang/RuntimeException");
      C_Name: Char_Array := To_C(Message);
      Result: Jint;
   begin
      Lock.Secure;
      Result := E.all.ThrowNew(E, Class, C_Name(C_Name'First)'Access);
      Lock.Release;
   end Raise_Java_Exception;

   procedure Raise_Java_Exception(E: JNIEnv; Event: Exception_Occurrence) is
   begin
      Raise_Java_Exception(E, Exception_Name(Event) & ": " & Exception_Message(Event));
   end Raise_Java_Exception;

end Jni;
